functor Interp (S : INTERP_STRUCTS) : INTERP =
struct
  open S
  
  structure A = Ast
  
  structure ErrorMsg = ErrorMsg
  exception RuntimeError
  
  val flag = true
  val debugPrint = fn s => if flag then print s else ()

  local open A
  in structure Id = A.Id
     structure Intl = A.Intl
     structure B = A.Binop
     structure T = A.Tipe
     structure L = A.Le
     structure S = A.Structs
     structure M = A.Stm
     structure F = A.Function
     structure P = A.Program
  end

  val error = ErrorMsg.error
  
  structure SMap = BinaryMapFn (type ord_key = Id.t
                                val compare = Id.compare)
                                
  structure IMap = BinaryMapFn (type ord_key = int
                                val compare = Int.compare)
                                
  structure Value :
  sig
    datatype t
      = BValue of bv
      | Struct of {id : Id.t, value : bv} list
      | Array of bv list
      
    and bv
      = Inti of int
      | True
      | False
      | Address of int
      | Junk
      
    val eval1 : t -> t
    val eval2 : t * B.t * t * int -> t
    val isTrue : t -> bool
    val getArrayElem : t * int -> t
    val getStructElem : t * Id.t -> t
    val toString : t -> string
  end =
  struct
    datatype t
      = BValue of bv
      | Struct of {id : Id.t, value : bv} list
      | Array of bv list
      
    and bv
      = Inti of int
      | True
      | False
      | Address of int
      | Junk
    
    fun test () = Atom.atom "aaa"
    fun getArrayElem (arr, off) =
        case arr 
         of (Array blist) => 
            let val bval = List.nth (blist, off) 
                    handle Subscript => raise Fail "invalid subscript"
                         | List.Empty => raise Fail "array empty, impossible"
            in  BValue bval
            end
          | BValue Junk => raise Fail "array element is junk\n"                                          
          | _ => raise Fail "Invalid"
    fun getStructElem (stru, id) =
        case stru
         of (Struct idlist) =>
            let fun f (elem : {id : Id.t, value : bv}) = Id.equals (#id elem, id)
                val bvalOpt = List.find f idlist
                val bval = case bvalOpt
                            of  NONE => raise Fail (String.concat ["no such field: ", Id.toString id])
                              | SOME {id, value} => value
            in BValue bval
            end
          | BValue Junk => raise Fail "struct element is junk\n"   
          | _ => raise Fail "Invalid"

    fun eval1 b =
        case b
         of BValue True => BValue False
          | BValue False => BValue True
          | _ => raise Fail "impossible"

    fun eval2 (v1, bop, v2, pos) =
        case bop
         of B.Plus =>
            (case (v1, v2)
              of (BValue (Inti i1), BValue (Inti i2)) => BValue (Inti (i1 + i2))
               | _ => raise Fail "bug\n")
          | B.Minus => 
            (case (v1, v2)
              of (BValue (Inti i1), BValue (Inti i2)) => BValue (Inti (i1 - i2))
               | _ => raise Fail "bug\n")
          | B.Times => 
            (case (v1, v2)
              of (BValue (Inti i1), BValue (Inti i2)) => BValue (Inti (i1 * i2))
               | _ => raise Fail "bug\n")
          | B.Divide => 
            (case (v1, v2)
              of (BValue (Inti i1), BValue (Inti i2)) => BValue (Inti (Int.div (i1, i2)))
               | _ => raise Fail "bug\n")
          | B.Modus =>
            (case (v1, v2)
              of (BValue (Inti i1), BValue (Inti i2)) => BValue (Inti (Int.mod (i1, i2)))
               | _ => raise Fail "bug\n")
          | B.And => 
            (case (v1, v2)
              of (BValue True, BValue True) => BValue True
               | (BValue True, BValue False) => BValue False
               | (BValue False, BValue True) => BValue False
               | (BValue False, BValue False) => BValue False
               | _ => raise Fail "bug\n")
          | B.Or =>
            (case (v1, v2)
              of (BValue True, BValue True) => BValue True
               | (BValue True, BValue False) => BValue True
               | (BValue False, BValue True) => BValue True
               | (BValue False, BValue False) => BValue False
               | _ => raise Fail "bug\n")
          | B.Eq =>
            (case (v1, v2)
              of (BValue (Inti i1), BValue (Inti i2)) => if i1 = i2 then BValue True else BValue False
               | (BValue (Address i1), BValue (Address i2)) => if i1 = i2 then BValue True else BValue False
               | (BValue Junk, BValue Junk) => 
                 (error pos "dangling pionter could not be compared\n"; raise RuntimeError)
               | _ => raise Fail "bug\n")
          | B.Ne =>
            (case (v1, v2)
              of (BValue (Inti i1), BValue (Inti i2)) => if i1 <> i2 then BValue True else BValue False
               | (BValue (Address i1), BValue (Address i2)) => if i1 <> i2 then BValue True else BValue False
               | _ => raise Fail "bug\n")
          | B.Gt =>            
            (case (v1, v2)
              of (BValue (Inti i1), BValue (Inti i2)) => if i1 > i2 then BValue True else BValue False
               | _ => raise Fail "bug\n")
          | B.Ge =>
            (case (v1, v2)
              of (BValue (Inti i1), BValue (Inti i2)) => if i1 >= i2 then BValue True else BValue False
               | _ => raise Fail "bug\n")
          | B.Lt =>
            (case (v1, v2)
              of (BValue (Inti i1), BValue (Inti i2)) => if i1 < i2 then BValue True else BValue False
               | _ => raise Fail "bug\n")
          | B.Le =>
            (case (v1, v2)
              of (BValue (Inti i1), BValue (Inti i2)) => if i1 <= i2 then BValue True else BValue False
               | _ => raise Fail "bug\n")               
                         
    fun isTrue t =
        case t
         of BValue True => true
          | _ => false



    fun toString2 t =
        case t
         of Inti i => Int.toString i
          | True => "true"
          | False => "false"
          | Address i => Int.toString i
          | Junk => "junk"
    fun toString t =
        case t
         of BValue bv => toString2 bv
          | Struct l => 
            String.concat ["{", 
                           String.concat (List.map (fn {id, value} => 
                                                       String.concat [Id.toString id,
                                                       "=", 
                                                       toString2 value, 
                                                       ","]) 
                                                    l),
                           "}"]
          | Array bvs => String.concat ["[", String.concat (List.map toString2 bvs), "]"]
  end
  
  structure Lval :
  sig
    datatype t
      = Id of Id.t
      | Address of int
      | Arrays of Id.t * int
      | Arrayh of int * int
      | Structs of Id.t * Id.t
      | Structh of int * Id.t
  end =
  struct
    datatype t
      = Id of Id.t
      | Address of int
      | Arrays of Id.t * int
      | Arrayh of int * int
      | Structs of Id.t * Id.t
      | Structh of int * Id.t
  end
  
  structure S :
  sig
    type t
    val empty : unit -> t
    val look : t * Id.t -> Value.t
    val enter : t * Id.t * Value.t -> t
    val update : t * Id.t * Value.t -> t
    val updateArrays : t * Id.t * int * Value.t -> t
    val updateStructs : t * Id.t * Id.t * Value.t -> t
    val toList : t -> (Id.t * Value.t) list
    val toString : t -> string
  end =
  struct
    datatype t
      = T of (Value.t SMap.map)
    
    fun empty () : t = T (SMap.empty)
    fun look (T t, k) =
        case SMap.find (t, k)
         of NONE => (error 0 (String.concat ["can not find: ", Id.toString k, " in S\n"]); raise Fail "bug\n")
          | SOME x => x
    fun enter (T t, k, v) = T (SMap.insert (t, k, v))
    fun update (t, k, v) = (look (t, k); enter (t, k, v))
    fun updateArrays (T t, k, i, v1) =
        case (look (T t, k), v1)
         of (Value.Array l, Value.BValue v) =>
            let fun cook (ll, count) =
                    case ll
                     of [] => [v]
                      | value :: xs =>
                        if count = i
                        then v :: xs
                        else value :: (cook (xs, count+1))
                val newl = cook (l, 0)
            in  enter (T t, k, Value.Array newl)
            end
          | (Value.BValue Junk, Value.BValue v) =>
            enter (T t, k, Value.Array [v])
          | _ => raise Fail "others \n"
    fun updateStructs (T t, k, s, v1) =
        case (look (T t, k), v1)
         of (Value.Struct l, Value.BValue v) =>
            let fun cook ll =
                    case ll
                     of [] => [{id = s, value = v}]
                      | {id, value} :: xs =>
                        if Id.equals (id, s)
                        then {id = id, value = v} :: xs
                        else {id = id, value = value} :: (cook xs)
                val newl = cook l
            in  enter (T t, k, Value.Struct newl)
            end
          | (Value.BValue Junk, Value.BValue v) =>
            enter (T t, k, Value.Struct [{id = s, value = v}])
          | _ => raise Fail "others \n"

    fun toList (T t) = SMap.listItemsi t

    fun toString (T t) =
        let val l = SMap.listItemsi t
            val l1 = ListFormat.listToString (fn (a, b) => 
                                                 String.concat [Id.toString a, 
                                                                " |-> ", 
                                                                Value.toString b]) 
                                             l
        in  l1
        end
  end
  
  structure H :
  sig
    type t
    val empty : unit -> t
    val look : t * int -> Value.t
    val enter : t * int * Value.t -> t
    val delete : t * int -> t
    val update : t * int * Value.t -> t
    val updateArrayh : t * int * int * Value.t -> t
    val updateStructh : t * int * Id.t * Value.t -> t
    val gcH : t * (int list)-> t
    val toString : t -> string
  end =
  struct
    datatype t
      = T of (Value.t IMap.map)
      
    fun empty () : t = T (IMap.empty) 
    fun look (T t, k) =
        case IMap.find (t, k)
         of NONE => (error 0 (String.concat ["can not find: ", 
                                             Int.toString k, 
                                             " in H\n"])
                   ; raise RuntimeError)
          | SOME x => x
    fun enter (T t, k, v) = T (IMap.insert (t, k, v))
    fun delete (T t, k) = (look (T t, k); T (#1 (IMap.remove (t, k))))
    fun update (T t, k, v) = (look (T t, k); enter (T t, k, v))
    fun updateArrayh (T t, base, off, v1) =
        case (look (T t, base), v1)
         of (Value.Array l, Value.BValue v) =>
            let fun cook (ll, count) =
                    case ll
                     of [] => [v]
                      | value :: xs =>
                        if count = off
                        then v :: xs
                        else value :: (cook (xs, count+1))
                val newl = cook (l, 0)
            in  enter (T t, base, Value.Array newl)
            end
          | (Value.BValue Junk, Value.BValue v) =>
            enter (T t, base, Value.Array [v])
          | _ => raise Fail "others \n"
    fun updateStructh (T t, k, s, v1) =
        case (look (T t, k), v1)
         of (Value.Struct l, Value.BValue v) =>
            let fun cook ll =
                    case ll
                     of [] => [{id = s, value = v}]
                      | {id, value} :: xs =>
                        if Id.equals (id, s)
                        then {id = id, value = v} :: xs
                        else {id = id, value = value} :: (cook xs)
                val newl = cook l
            in  enter (T t, k, Value.Struct newl)
            end
          | (Value.BValue Junk, Value.BValue v) =>
            enter (T t, k, Value.Struct [{id = s, value = v}])
          | _ => raise Fail "others \n"
    fun gcH (T t, il) = 
        let fun filt (k, a) = List.exists (fn k' => k=k') il
            val newt = IMap.filteri filt t
        in  T newt
        end
    fun toString (T t) =
        let val l = IMap.listItemsi t
            val ll = ListFormat.listToString (fn (a, b) => 
                                                 String.concat [".L", 
                                                                Int.toString a, 
                                                                " |-> ", 
                                                                Value.toString b])
                                             l
        in  ll
        end
  end
  
  structure G :
  sig
    type t
    val look : t * Id.t -> Value.t
    val enter : t * Id.t * Value.t -> t
    val empty : unit -> t
  end =
  struct
    datatype t
      = T of (Value.t SMap.map)
      
    fun empty () : t = T (SMap.empty)
    fun look (t, k) = raise Fail "todo\n"
    fun enter (t, k, v) = raise Fail "todo\n"
  end  
  
  structure K :
  sig
    type t
    val empty : unit -> t
    val push : t * M.t -> t
    val pop : t -> (t * M.t)
    val isEmpty : t -> bool
  end =
  struct
    datatype t
      = T of M.t list
      
    fun empty () : t = T ([])  
    fun push (T t, k) =  T (k :: t)
    fun pop (T t) =
        case t
         of [] => (empty (), M.bogus ())
          | x :: xs => (T xs, x)
    
    fun isEmpty (T s) =
        case s
         of [] => true
          | _ => false
  end
  
  structure R :
  sig
    type t
    val empty : unit -> t
    val push : t * (S.t * K.t) -> t
    val pop : t -> t * (S.t * K.t)
    val isEmpty : t -> bool
    val getSlist : t -> S.t list
  end =
  struct
    datatype t
      = T of {s : S.t, k : K.t} list

    fun getSlist (T skl) = List.map (fn {s, k} => s) skl        
    fun empty () : t = T [{s = S.empty (), k = K.empty ()}]
    fun push (t, (s, k)) =
        case t
         of T items => T ({s = s, k = k} :: items)
    fun pop t = 
        case t
         of T [] => (t, raise Fail "empty?\n")
          | T ({s, k} :: xs) => (T xs, (s, k))
    fun isEmpty (T l) = 
        case l
         of [] => true
          | [{s, k}] => K.isEmpty k
          | _ => false
  end
  
  structure State :
  sig
    type t
    val eax : Value.t ref
    val code : A.Program.t option ref
    val getFunc : Id.t -> A.Function.t
    val empty : unit -> t
    val slook : t * Id.t -> Value.t
    val senter : t * Id.t * Value.t -> t
    val getS : t -> S.t
    val glook : t * Id.t -> Value.t
    val genter : t * Id.t * Value.t -> t
    val hlook : t * int -> Value.t
    val henter : t * int * Value.t -> t
    val getH : t -> H.t
    val rpush : t -> t
    val rpop : t -> t * (S.t * K.t)
    val getR : t -> R.t
    val kpush : t * M.t -> t
    val kpop : t -> (t * M.t)
    val update : t * Lval.t * Value.t -> t
    val return : t -> t
    val call : t -> t
    val nextStm : t -> t * M.t
    val free : t * Value.t * int -> t
    val isHalt : t -> bool
    val toString : t -> string
    val fl2string : unit -> string
    val ul2string : unit -> string

(*    val totals : int ref *)
    val freelist : int list ref
    val uselist : (int * bool) list ref
    val newAddress : t -> (Value.t * t)

  end =
  struct
    datatype t
      = T of {s : S.t,
              h : H.t,
              g : G.t,
              r : R.t,
              k : K.t}
    
    fun empty () : t = T {s = S.empty (), h = H.empty (), g = G.empty (), r = R.empty (), k = K.empty ()}
    val code : A.Program.t option ref = ref NONE
    fun getFunc1 (f, s) =
        case f
         of A.Function.T {name,
                          rettype,
                          args,
                          locals,
                          stm,
                          pre,
                          post,
                          pos} =>
            Id.equals (s, name)            
            
    fun getFunc s =
        case (!code)
         of SOME (A.Program.T {structs, 
                         gvars,
                         funcs,
                         pos}) =>
            let val l = List.filter (fn a => getFunc1 (a, s)) funcs
            in  case l
                 of [] => (error pos (String.concat ["no this function: ",
                                                      Id.toString s,
                                                      "\n"])
                         ; raise RuntimeError)
                  | [x] => x
                  | _ => (error pos "compiler bug\n"; raise RuntimeError)
            end
          | _ => raise Fail "bug"
    val eax = ref (Value.BValue Value.True)
    fun slook (T {s, h, g, r, k}, id) = S.look (s, id)
    fun senter (T {s, h, g, r, k}, id, v) = T {s = S.enter (s, id, v), h = h, g = g, r = r, k = k}
    fun getS (T {s, h, g, r, k}) = s
    fun glook (T {s, h, g, r, k}, id) = G.look (g, id)
    fun genter (T {s, h, g, r, k}, id, v) = T {s = s, h = h, g = G.enter (g, id, v), r = r, k = k}
    fun hlook (T {s, h, g, r, k}, i) = H.look (h, i)
    fun henter (T {s, h, g, r, k}, i, v) = T {s = s, h = H.enter (h, i, v), g = g, r = r, k = k}
    fun getH (T {s, h, g, r, k}) = h
    fun getG (T {s, h, g, r, k}) = g
    fun getK (T {s, h, g, r, k}) = k
    fun rpush (T {s, h, g, r, k}) = T {s = s, h = h, g = g, r = R.push (r, (s, k)), k = k}
    fun rpop (T {s, h, g, r, k}) = 
        let val (newr, (s, k)) = R.pop r
        in  (T {s = s, h = h, g = g, r = newr, k = k}, (s, k))
        end
    fun getR (T {s, h, g, r, k}) = r
    fun kpush (T {s, h, g, r, k}, stm) = T {s = s, h = h, g = g, r = r, k = K.push (k, stm)}
    fun kpop (T {s, h, g, r, k}) = 
        let val (newk, stm) = K.pop k
        in  (T {s = s, h = h, g = g, r = r, k = newk}, stm)
        end
    fun update (T {s, h, g, r, k}, l, v) =
        case l
         of Lval.Id id => T {s = S.update (s, id, v), h = h , g = g, r = r, k = k}
          | Lval.Address i => T {s = s, h = H.update (h, i, v), g = g, r = r, k = k}
          | Lval.Arrays (id, off) => T {s = S.updateArrays (s, id, off, v), h = h , g = g, r = r, k = k}
          | Lval.Arrayh (base, off) => T {s = s, h = H.updateArrayh (h, base, off, v) , g = g, r = r, k = k}
          | Lval.Structs (id, ss) => T {s = S.updateStructs (s, id, ss, v), h = h , g = g, r = r, k = k}
          | Lval.Structh (base, ss) => T {s = s, h = H.updateStructh (h, base, ss, v) , g = g, r = r, k = k}
    fun return state =
        let val (T {s, h, g, r, k}, (s1, k1)) = rpop state
        in  T {s = s1, h = h, g = g, r = r, k = k1}
        end
    fun call state =
        let val (T {s, h, g, r, k}) = rpush state
        in  T {s = S.empty (), h = h, g = g, r = r, k = K.empty ()}
        end
    fun nextStm state = kpop state

          
    fun isHalt (T {s, h, g, r, k}) = K.isEmpty k andalso R.isEmpty r
    fun toString (T {s, h, g, r, k}) =
        String.concat ["S=", S.toString s, "\n",
                       "H=", H.toString h, "\n",
                       "G=[", "]\n",
                       "R=[", "]\n",
                       "K=[", "]\n\n"]

    fun getAllS state = 
        let val s = getS state
            val sl = R.getSlist (getR state)
        in  s :: sl
        end
    val heapSize = 9
    val freelist = ref (List.tl (List.tabulate (9, fn i => i)))
    val uselist : (int * bool) list ref = ref []
    fun fl2string () = 
        ListFormat.listToString (Int.toString) (!freelist)
    fun ul2string () =
        ListFormat.listToString (fn (i, tag) => 
                                    String.concat ["(",
                                                   Int.toString i,
                                                   ", ", 
                                                   Bool.toString tag, ")"]) 
                                (!uselist)
    fun insertF i =
        let fun ins fl =
                case fl
                 of [] => [i]
                  | ii :: l => if i > ii
                             then ii :: (ins l)
                             else if i < ii
                             then i :: ii :: l
                             else raise Fail "duplicate memory"
        in  freelist := ins (!freelist)
        end
    fun insertU (i, tag) =
        let fun ins ul =
                case ul
                 of [] => [(i, tag)]
                  | (i', tag') :: l => if i>i'
                                     then (i',tag') :: (ins l)
                                     else if i < i'
                                     then (i, tag) :: (i', tag') :: l
                                     else raise Fail "duplicate memory"
        in  uselist := ins (!uselist)
        end
    fun deleteU i =
        let fun del ul =
                case ul
                 of [] => (error 0 "can not delete";
                           raise RuntimeError)
                  | (i', tag)::l => if i = i'
                                    then l
                                    else if i < i'
                                    then (error 0 "can not delete";
                                          raise RuntimeError)
                                    else del l
        in  uselist := del (!uselist)
        end
    fun freeMemNum ()= List.length (!freelist)
    fun newMem () =  
        let val addr = List.hd (!freelist) handle List.Empty => raise Fail "impossible"
            val _ = freelist := List.tl (!freelist) handle List.Empty => raise Fail "impossible"
            val _ = insertU (addr, false) 
        in  addr
        end
    fun freeMem i = (deleteU i; insertF i)
    fun clearMark () = 
        let fun dealList usel = 
                case usel
                 of [] => []
                  | (i, true) :: xs => (i, false) :: (dealList xs)
                  | (i, false) :: xs => (insertF i;
                                         dealList xs)
            val _ = debugPrint ("before clearMark : \n")
            val _ = debugPrint ("uselist: ")
            val _ = debugPrint (ul2string ())
            val _ = uselist := dealList (!uselist)
        in  ()
        end

    fun marked i = 
        let fun m ul =
                case ul
                 of [] => (error 0 ("can not find " ^ (Int.toString i));
                           raise RuntimeError)
                  | (i', tag)::l => if i = i'
                                    then tag
                                    else if i < i'
                                    then (error 0 ("can not find " ^ (Int.toString i));
                                          raise RuntimeError)
                                    else m l
        in  m (!uselist)
        end

    fun markU i = 
        let fun m ul =
                case ul
                 of [] => (error 0 ("can not find " ^ (Int.toString i));
                           raise RuntimeError)
                  | (i', tag)::l => if i = i'
                                    then (i, true) :: l
                                    else if i < i'
                                    then (error 0 ("can not find " ^ (Int.toString i));
                                          raise RuntimeError)
                                    else (i', tag) :: (m l)
        in  uselist := m (!uselist)
        end

    fun traceh (i, state) =
        let val h = getH state
        in  if (i = 0) orelse (marked i)
            then ()
            else let val _ = markU i;
                     val nextv = H.look (h, i)
                 in  tracev (nextv, state)
                 end
        end
    and tracebv (bv, state) =
        case bv
         of Value.Address 0 => ()
          | Value.Address i => traceh (i, state)
          | _ => ()

    and tracev (v, state) =
        case v 
         of Value.BValue bv => tracebv (bv, state)
          | Value.Struct fl => List.app (fn {id, value} => tracebv (value, state)) fl
          | Value.Array bvl => List.app (fn bv => tracebv (bv, state)) bvl
    fun gcState state =
        let val h = getH state
            val ul = List.map (fn (i, tag) => i) (!uselist)
            val newh = H.gcH (h, ul)
            val newstate = T {s = getS state, h = newh, r = getR state, g = getG state, k = getK state}
        in  newstate
        end
    fun gc state = 
        let val _ = debugPrint "before GC: \n"
            val _ = debugPrint "freelist: "
            val _ = debugPrint (fl2string ())
            val _ = debugPrint "uselist: "
            val _ = debugPrint (ul2string ())
            val _ = debugPrint (toString state)
            val sl = getAllS state
            val vsl = List.map (S.toList) sl
            fun trace (s,v) = tracev (v, state)
            fun dealS s = List.app trace (S.toList s)
            val _ = List.app dealS sl
            val _ = clearMark ()
            val newstate = gcState state         
        in  debugPrint "after GC: \n";
            debugPrint "freelist: ";
            debugPrint (fl2string ());
            debugPrint "uselist: ";
            debugPrint (ul2string ());
            debugPrint (toString newstate);
            newstate
        end

    fun newAddress state =
        let val (newstate, newaddr) = 
                if freeMemNum () = 0
                then (gc state,
                      if freeMemNum () = 0
                      then (error 0 "memory exhausted.";
                            raise RuntimeError)
                      else newMem ())
                else (state, newMem ())
        in  (Value.BValue (Value.Address (newaddr)), newstate)
        end

    fun free (T {s, h, g, r, k}, v, pos) =
        case v
         of Value.BValue (Value.Address i) =>
            let val st =  T {s = s, h = H.delete (h, i), g = g, r = r, k = k}
            in  (freeMem i;
                 st)
            end
          | Value.BValue (Value.Junk) =>
            (error pos "dangling pointer could not be freed\n"; raise RuntimeError)
          | _ => raise Fail "bug\n"

  end
  
  structure Machine :
  sig
    val evalExp : State.t * L.exp -> Value.t
    val evalLvalr : State.t * L.lval -> Value.t
    val evalLvall : State.t * L.lval -> Lval.t
    val evalStm : State.t * M.t -> State.t
    val evalGvdec : State.t * {id : Id.t, ty : T.t} -> State.t
    val evalLvdec : State.t * {id : Id.t, ty : T.t} -> State.t
    val evalFunction : State.t * A.Function.t * Value.t list -> State.t
    val evalProgram : State.t * A.Program.t -> unit
    val eval : A.Program.t -> unit
  end =
  struct

    fun evalLvalr (state, lval) = 
        case lval
         of L.Var (id, _) => State.slook (state, id)
          | L.Inptr (lv, _) => 
            let val value = evalLvalr (state, lv)
                val addr = case value
                            of  Value.BValue (Value.Address i) => i
                              | _ => raise Fail "bug"
            in  State.hlook (state, addr)
            end
          | L.Inarray (lv, exp, _) => 
            let val arr = evalLvalr (state, lv)
                val off = case evalExp (state, exp)
                           of  Value.BValue (Value.Inti i) => i
                             | _ => raise Fail "bug"
            in  Value.getArrayElem (arr, off) 
            end
          | L.Instruct (lv, id, _) =>
            let val stru = evalLvalr (state, lv)
            in  Value.getStructElem (stru, id)
            end
          | L.Ptstruct (lv, id, pos)=> 
            evalLvalr (state, (L.Instruct (L.Inptr (lv, pos), id, pos)))
          | L.Ptstruct2 (_, _, _, _) => raise Fail "impossilbe"

    and evalExp (state, exp) = 
        case exp 
          of L.Expvoid => raise Fail "bug"
           | L.IntNum i => Value.BValue (Value.Inti (Intl.toInt i))
           | L.True => Value.BValue Value.True
           | L.False => Value.BValue Value.False
           | L.Null => Value.BValue (Value.Address 0)
           | L.BinopExp (e1, bop, e2, pos) =>
             let val v1 = evalExp (state, e1)
                 val v2 = evalExp (state, e2)
             in  Value.eval2 (v1, bop, v2, pos)
             end
           | L.NotExp (e, _) =>
             let val v = evalExp (state, e)
             in  Value.eval1 v
             end
           | L.Lval l => evalLvalr (state, l)
           | _ => raise Fail "impossible"

    fun evalLvall (state, lval) = 
        case lval
         of L.Var (id, _) => Lval.Id id
          | L.Inptr (lv, _) => 
            (case evalLvalr (state, lv)
              of Value.BValue (Value.Address i) => Lval.Address i
               | _ => raise Fail "impossible")
          | L.Inarray (lv, exp, _) =>
            let val arr = evalLvall (state, lv)
                val off = case evalExp (state, exp)
                           of Value.BValue (Value.Inti i) => i
                            | _=> raise Fail "bug"
            in  case arr
                 of Lval.Id id => Lval.Arrays (id, off)
                  | Lval.Address i => Lval.Arrayh (i, off)
                  | _ => raise Fail "impossible"
            end
          | L.Instruct (lv, idf, _) =>
            let val stru = evalLvall (state, lv)
            in  case stru
                 of Lval.Id id => Lval.Structs (id, idf)
                  | Lval.Address i => Lval.Structh (i, idf)
                  | _ => raise Fail "impossible"
            end
          | L.Ptstruct (lv, idf, pos) =>
            evalLvall (state, L.Instruct ((L.Inptr (lv, pos)), idf, pos))
          | L.Ptstruct2 _ => raise Fail "impossible"

    fun evalStm (state, stm) =
        case stm
         of M.AsnExp (lval, exp, pos) =>
            let val v = evalExp (state, exp)
                val lval' = evalLvall (state, lval)
                val m1 = State.update (state, lval', v)
            in  m1
            end
          | M.AsnCall (lval, id, es, pos) =>
            let val vs = List.map (fn a => evalExp (state, a)) es
                val f = State.getFunc id
                val m11 = State.call state 
                val m0 = evalFunction (m11, f, vs)
                val lval' = evalLvall (m0, lval)
                val m1 = State.update (m0, lval', !State.eax)
            in  m1
            end
          | M.AsnAlloc (lval, ty, pos) =>
            let val (address, state') = (State.newAddress state)
                val i = case address
                         of Value.BValue (Value.Address i) => i
                          | _ => raise Fail "bug\n"
                val lval' = evalLvall (state', lval)
                val m0 = State.henter (state', i, Value.BValue (Value.Junk))
                val m1 = State.update (m0, lval', address)
            in  m1
            end
          | M.If (e, s1, s2, pos) =>
            let val v = evalExp (state, e)
                val m1 = if Value.isTrue v
                         then evalStms (state, s1)
                         else evalStms (state, s2)
            in  m1
            end
          | ss as M.While {condition, invariant, body, pos} =>
            let val v = evalExp (state, condition)
                val m1 = if Value.isTrue v
                         then let val m2 = evalStms (state, body)
                              in  evalStm (m2, ss)
                              end
                         else if State.isHalt state
                              then state
                              else raise Fail "todo\n"
            in  m1
            end
          | M.Return (L.Expvoid, pos) =>
            let val m1 = State.return state
            in  if State.isHalt m1
                then m1
                else m1
            end
          | M.Return (e, pos) =>
            let val v = evalExp (state, e)
                val _ = (State.eax := v)
                val m1 = State.return state              
            in  if State.isHalt m1
                then m1
                else m1
            end
          | M.Call (id, es, pos) => 
            if Id.equals (id, Id.fromString "print")
            then 
            let val vs = List.map (fn a => evalExp (state, a)) es
                val num = case (List.hd vs)
                           of Value.BValue (Value.Inti i) => i
                            | _ => raise Fail "impossible"
            in  print ((Int.toString num) ^ "\n");
                state
            end
            else if Id.equals (id, Id.fromString "printb")
                 then
          let val vs = List.map (fn a => evalExp (state, a)) es
                val b = case (List.hd vs)
                         of Value.BValue (Value.True) => "true\n"
                          | Value.BValue (Value.False) => "false\n" 
                          | _ => raise Fail "impossible"
            in  print b;
                state
            end
            else if Id.equals (id, Id.fromString "printp")
                 then
            let val vs = List.map (fn a => evalExp (state, a)) es
                val addr = case (List.hd vs)
                           of Value.BValue (Value.Address i) => String.concat ["Address ", Int.toString i, "\n"]
                            | Value.BValue Value.Junk => "Junk\n"
                            | _ => raise Fail "impossible"
            in  print addr;
                state
            end
            else
            let val vs = List.map (fn a => evalExp (state, a)) es
                val f = State.getFunc id
                val m1 = State.call state
                val m2 = evalFunction (m1, f, vs)
            in  m2
            end
          | M.Free(e, pos) =>
            let val v = evalExp (state, e)
            in  State.free (state, v, pos)
            end
          | M.Prop(e, pos) => raise Fail "bug\n"
          
    and evalStms (state, ss) =
        case ss
         of [] => state
          | x :: xs =>
            let val state' = evalStm (state, x)
            in  evalStms (state', xs)
            end
          
    and evalGvdec (state, {id, ty}) =
        State.genter (state, id, Value.BValue (Value.Junk))
        
    and evalLvdec (state, {id, ty}) =
        State.senter (state, id, Value.BValue (Value.Junk))
        
    and evalFunction (state, f, paras) =
        case f
         of A.Function.T {name,
                          rettype,
                          args,
                          locals,
                          stm,
                          pre,
                          post,
                          pos} =>
           let val idvs = ListPair.zip (List.map #id args, paras)
               val m0 = List.foldl (fn ((id, v), b) => State.senter (b, id, v)) state idvs
               val _ = debugPrint (State.toString m0)
               val _ = debugPrint ("freelist: "^ (State.fl2string ()))
               val _ = debugPrint ("uselist: "^ (State.ul2string ())^"\n\n")
               val m1 = List.foldl (fn (a, b) => evalLvdec (b, a)) m0 locals
               val _ = debugPrint (State.toString m1)
               val _ = debugPrint ("freelist: "^ (State.fl2string ()))
               val _ = debugPrint ("uselist: "^ (State.ul2string ())^"\n\n")
               val m2 = evalStms (m1, stm)
               val _ = ()
           in  m2
           end
         
    fun evalProgram (state, prog) =
        case prog
         of A.Program.T {structs,
                         gvars,
                         funcs,
                         pos} =>
            let val m1 = List.foldl (fn (a, b) => evalGvdec (b, a)) state gvars
                val main = State.getFunc (Id.fromString "main")
                val m2 = evalFunction (m1, main, [])
            in  ()
            end
                        
    fun eval prog =
        let val initState = State.empty ()
            val _ = State.code := SOME prog
            val _ = State.freelist := [1,2,3,4,5,6,7,8,9]
            val _ = State.uselist := []
        in  evalProgram (initState, prog)
        end
  end  
       
  fun top ast = (Machine.eval ast) handle RuntimeError => ()
end
